home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qbmouse.zip
/
MOUSE.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-07-01
|
16KB
|
373 lines
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ,,,,,,,,,,,,,,,,,,,,,,,,,,,,, '
' Robert Seace ; QB Mouse Support Routines ; '
' RFD 2 Box 229 ''''''''''''''''''''''''''''' '
' Littleton, NH 03561 Feel free to distribute! '
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Filename: MOUSE.BAS '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Note: To use these routines, you must either link in the compiled
' object code (MOUSE.OBJ) and the QB.LIB library, or simply use
' the included MOUSE.LIB library. At the linker's prompt for
' libraries, type "mouse.lib" (actually, I would probably type
' "bcom45.lib+mouse.lib", which would also link in the compile
' time library to produce a stand-alone executable file, as well).
' Using this MOUSE.LIB method, you need not bother to link in the
' MOUSE.OBJ object code along with your own compiled object code,
' nor do you need to link in the QB.LIB library, as it is already
' contained within the MOUSE.LIB library. Simply include MOUSE.BI
' at the top of your code (use the "'$include: 'mouse.bi'"
' metacommand; note that it must be within a comment, and there
' should be only spaces/tabs next to the dollar sign, unless it
' is put directly next to the FIRST single-quote (apostrophe)
' marking the comment), then compile your code, and link it with
' the MOUSE.LIB library, and you'll be all set.
' If you want to use the mouse functions within the QB environment,
' use the MOUSE.QLB QuickLibrary (start QB using the /L parameter:
' "qb /L mouse").
'$INCLUDE: 'mouse.bi'
DIM SHARED inreg AS RegType ' Input Registers; used in CALL INTERRUPT
DIM SHARED outreg AS RegType ' Output Registers; used in CALL INTERRUPT
DIM SHARED inregx AS RegTypeX ' Extended Input Registers w/ segment
DIM SHARED outregx AS RegTypeX ' Extended Output Registers w/ segment
' Internal variables used by various mouse functions
DIM SHARED mINIT AS INTEGER, mGRAPHICS AS INTEGER
DIM SHARED mXlast AS INTEGER, mYlast AS INTEGER
mINIT = 0
mGRAPHICS = 0
mXlast = 0
mYlast = 0
FUNCTION MouseButton (event AS MouseEvent, debounce AS INTEGER)
' ---------------------------=< MouseButton >=-------------------------
' Detects whether or not a mouse button has been pressed. Works the
' same way as MouseMove (returns TRUE and updates passed MouseEvent
' structure if button pressed, else returns FALSE). The second
' parameter of the function determines whether or not the buttons will
' be "debounced" after reading a press. Debouncing means that the
' function will wait until the button is no longer pressed anymore
' before it returns to the caller. This is a good thing to use,
' because a single click of a mouse button can often produce several
' button-press events, due to the sensitivity of the mouse buttons.
' Using the debounce option (passing TRUE, or any non-zero value, as
' the second parameter) eliminates these extra button-press events and
' prevents possible problems with thinking the user has clicked more
' than he has. However, I left the option of not debouncing because
' it is possible you may want to keep track of held-down buttons (for
' dragging the mouse through pull-down menus, or other such things
' where the user must hold down the button); in this case, simply pass
' FALSE (0) as the second parameter.
IF mINIT = 0 THEN ' Not initialized/available
MouseButton = 0
EXIT FUNCTION
END IF
inreg.ax = 3
CALL INTERRUPT(&H33, inreg, outreg) ' Get pos/button info
IF outreg.bx > 0 THEN ' a button(s) is pressed
event.buttons = outreg.bx
IF mGRAPHICS = 0 THEN ' text mode
outreg.cx = INT(outreg.cx / 8) + 1
outreg.dx = INT(outreg.dx / 8) + 1
ELSEIF mGRAPHICS = 1 THEN ' graphics mode 1
outreg.cx = INT(outreg.cx / 2)
END IF
event.x = outreg.cx
event.y = outreg.dx
mXlast = outreg.cx
mYlast = outreg.dx
IF debounce <> 0 THEN ' User wants to debounce buttons
WHILE outreg.bx > 0 ' While a button(s) is pressed...
CALL INTERRUPT(&H33, inreg, outreg) ' get pos/button info
WEND
END IF
MouseButton = NOT 0
ELSE
MouseButton = 0
END IF
END FUNCTION
SUB MouseGetInfo (event AS MouseEvent)
' --------------------------=< MouseGetInfo >=--------------------------
' This subroutine gets the position of mouse pointer (actual screen
' position, dependent upon screen mode), and the button info, whether
' or not there is a new event (position has changed or button pressed).
' The info is returned through the event parameter passed to it.
' Note: Calling this subroutine updates the last known values for the
' position of the mouse pointer, so that even if the position IS new
' (it has moved), then calling MouseMove after calling this will NOT
' reveal the change in position, as you've chosen to ignore the move
' by calling this subroutine.
' Note: No debouncing at all is done in this subroutine. It simply
' gives you the current status of the buttons, without caring whether
' any of them are pressed or not.
IF mINIT = 0 THEN ' Not initialized/available
EXIT SUB
END IF
inreg.ax = 3
CALL INTERRUPT(&H33, inreg, outreg) ' Get position/button info
IF mGRAPHICS = 0 THEN ' Text mode
outreg.cx = INT(outreg.cx / 8) + 1
outreg.dx = INT(outreg.dx / 8) + 1
ELSEIF mGRAPHICS = 1 THEN ' Graphics mode 1
outreg.cx = INT(outreg.cx / 2)
END IF
event.x = outreg.cx
event.y = outreg.dx
event.buttons = outreg.bx
mXlast = outreg.cx
mYlast = outreg.dx
END SUB
SUB MouseGraphicsPtr (hotx AS INTEGER, hoty AS INTEGER, map AS BitMap)
' ----------------------=< MouseGraphicsPtr >=------------------------
' The graphics-mode version of MouseTextPrt. You pass it the position
' of the cursor hot-spot within the bitmap, and the actual 16 bit X
' 16 bit bitmap you want to use as the new pointer shape, as well as a
' similar such bitmap for the screen mask (this first gets ANDed with
' what is on the screen where the pointer is, then the pointer's bitmap
' gets XORed with the result of that). There is a type defined (BitMap)
' which contains the 32 integers (each 16 bits) necessary to hold both
' of these bitmaps.
IF mINIT = 0 OR mGRAPHICS = 0 THEN ' Not init., or in text mode
EXIT SUB
END IF
inregx.ax = 9
inregx.bx = hotx
inregx.cx = hoty
inregx.dx = VARPTR(map) ' location of variable; offset from segment
inregx.es = VARSEG(map) ' location of variable's segment
CALL INTERRUPTX(&H33, inregx, outregx) ' define graphics cursor
END SUB
SUB MouseHide
' ----------------------------=< MouseHide >=--------------------------
' Hides the mouse pointer (shuts it off). I advise hiding before every
' CLS, then turning it back on with MouseShow after screen is fully
' drawn (especially if changing screen color). Otherwise, the pointer
' may interfere with stuff being drawn on the screen.
IF mINIT = 0 THEN ' Not initialized/available
EXIT SUB
END IF
inreg.ax = 2
CALL INTERRUPT(&H33, inreg, outreg) ' Hide the pointer
END SUB
FUNCTION MouseInit (mode AS INTEGER)
' ---------------------------=< MouseInit >=---------------------------
' Function which initializes the mouse for use. The argument passed
' should be 0 for normal text-mode (80 columns X 25 rows) screen, or
' 1 for graphics-mode resolution 1 (320 X 200), or 2 for graphics-mode
' resolution 2 (640 X 200; same as mouse's own virtual screen). The
' return value is 0 if no mouse is available for use, otherwise it i